home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / dirsplit < prev    next >
Text File  |  2006-11-25  |  17KB  |  612 lines
  1. #!/usr/bin/perl
  2. #                              -*- Mode: Perl -*-
  3. # dirsplit ---
  4. # Author           : Eduard Bloch ( blade@debian.org )
  5. # Last Modified On : Sun, 06 Feb 2005 14:59:51 +0100
  6. # Status           : Working, but use with caution!
  7. # License: GPLv2
  8.  
  9. my $version="0.3.3";
  10.  
  11. require v5.8.1;
  12. use strict;
  13. use List::Util 'shuffle';
  14. use Getopt::Long qw(:config no_ignore_case bundling);
  15. use File::Basename;
  16. use File::Path;
  17. use Cwd 'abs_path';
  18.  
  19. my $ret=0;
  20. my $max="4488M";
  21. my $prefix="vol_";
  22. my $acc=20;
  23. my $emode=1;
  24. my $bsize=2048;
  25. my $ofac =50;
  26. my $opt_help;
  27. my $opt_longhelp;
  28. my $opt_sim;
  29. my $opt_dir;
  30. my $opt_flat;
  31. my $opt_move;
  32. my $opt_ver;
  33. my $opt_sln;
  34. my $opt_ln;
  35. my $opt_filter;
  36. my $opt_simple;
  37. my $opt_follow;
  38. my $get_ver;
  39. my $opt_listfile;
  40.  
  41.  
  42. my %options = (
  43.    "h|help"                => \$opt_help,
  44.    "d|dirhier"            => \$opt_dir,
  45.    "flat"            => \$opt_flat,
  46.    "f|filter=s"            => \$opt_filter,
  47.    "F|follow"            => \$opt_follow,
  48.    "e|expmode=i"            => \$emode,
  49.    "o|overhead=i"            => \$ofac,
  50.    "b|blksize=i"            => \$bsize,
  51.    "n|no-act"            => \$opt_sim,
  52.    "m|move"            => \$opt_move,
  53.    "l|symlink"            => \$opt_sln,
  54.    "L|hardlink"           => \$opt_ln,
  55.    "v|verbose"            => \$opt_ver,
  56.    "s|size=s"             => \$max,
  57.    "S|simple"             => \$opt_simple,
  58.    "T|input=s"       => \$opt_listfile,
  59.    "p|prefix=s"              => \$prefix,
  60.    "a|accuracy=i"            => \$acc,
  61.    "H|longhelp"            => \$opt_longhelp,
  62.    "version"                 => \$get_ver
  63. );
  64.  
  65. &show_help(1) unless ( GetOptions(%options));
  66. &show_help(1) if $opt_help;
  67. &show_longhelp if $opt_longhelp;
  68. if($get_ver) {
  69.    print $version;
  70.    exit 0;
  71. }
  72.  
  73. # ignore the old dirhier setting since it is default now and disable the flag when opt_flat is specified
  74. $opt_dir = !$opt_flat;
  75.  
  76. $opt_ver = 1 if $opt_sim;
  77. $opt_move=1 if ($opt_sln || $opt_ln);
  78.  
  79. # big list @sizes containing the "items" (object sizes)
  80. # %names hash mapping "items" (size as key) to arrays with filenames/subarrays for coalesced files
  81. my @sizes;
  82. my %names;
  83.  
  84. # result containts the calculated output. In simple mode, an
  85. # array (bins) of atoms (files or filelists). Otherwise, sizes
  86. # instead of atoms, to be resolved with %names.
  87. my @result;
  88.  
  89. my $inputdir;
  90.  
  91. $max=fixnr($max);
  92. # about 400kB for iso headers
  93. $max-=420000;
  94.  
  95. # init default value
  96. my $globwaste=0;
  97.  
  98.  
  99. if(-d $ARGV[0] || (-d readlink($ARGV[0]))) {
  100.    syswrite(STDOUT,"Building file list, please wait...\n");
  101.    # save the absolut path before doing anyhting
  102.    $inputdir=Cwd::abs_path($ARGV[0]);
  103.    &explore($inputdir);
  104. }
  105. elsif($opt_listfile) {
  106.    if($opt_listfile eq "-") {
  107.       &parseListe(\*STDIN);
  108.    }
  109.    else {
  110.       open(my $in, "<", $opt_listfile) || die "Cannot open list file $opt_listfile\n";
  111.       &parseListe($in);
  112.    }
  113. }
  114. else {
  115.    die "Error: please specify a directory\n";
  116. }
  117.  
  118. # check for pointless requests
  119. my $testsize=0;
  120. for(@sizes) {
  121.    die "Too large object(s) ($_) for the given max size: @{$names{$_}} (maybe coalesced in arrays, check manually)\n" if($_>$max);
  122.  
  123.    $testsize+=$_;
  124. }
  125.  
  126. $acc=1 if ($testsize <= $max); # just generate a list, more trials are pointless
  127. print "\nSumm: $testsize\n" if($opt_ver);
  128. die "Nothing to do!\n" if($testsize<4096); # looks like just an empty dir
  129.  
  130. if(!$opt_simple) {
  131.    syswrite(STDOUT, "Calculating, please wait...\n");
  132.    my $starttime=time;
  133.    $globwaste=$max*@sizes;
  134.    for(1..$acc) {
  135.       syswrite(STDOUT,".");
  136.       my @tmp;
  137.       #my $waste = bp_bestfit($max, \@in, \@tmp);
  138.       my $waste = bp_firstfit($max, \@sizes, \@tmp);
  139.       #print "D: waste - $waste\n";
  140.       if($waste < $globwaste) {
  141.          $globwaste=$waste;
  142.          @result=@tmp;
  143.       }
  144.       if($starttime && time > $starttime+10) {
  145.          syswrite(STDOUT,"\nSpent already over 10s (for $_ iterations)\nHint: reduce accuracy to make it faster!\n");
  146.          undef $starttime;
  147.       }
  148.       @sizes=shuffle(@sizes);
  149.    }
  150.  
  151. }
  152.  
  153. print "\nCalculated, using ".(scalar @result)." volumes.\n";
  154. print "Wasted: $globwaste Byte (estimated, check mkisofs -print-size ...)\n";
  155.  
  156. # and the real work
  157. my $i=0;
  158. my $inDirLen=length($inputdir);
  159. for(@result) {
  160.    $i++;
  161.    my $o;
  162.    open($o, ">$prefix$i.list") if(! ($opt_move || $opt_sim));
  163.    my $dirPrefix=dirname($prefix);
  164.    my $prefixBase=basename($prefix);
  165.    my $dirPrefixAbs=Cwd::abs_path($dirPrefix);
  166.  
  167.    for(@{$_}) {
  168.       my $stuffRef;
  169.       
  170.       # For simple mode, the files/atoms are already resolved, otherwise take
  171.       # the next with appropriate size. 
  172.       my $item= $opt_simple ? $_ : shift(@{$names{$_}});
  173.  
  174.       # make reference point to an array with our files, create a list if needed
  175.       if(ref($item) eq "ARRAY") {
  176.          $stuffRef=$item;
  177.       }
  178.       else {
  179.          $stuffRef=[$item];
  180.       }
  181.  
  182.       for my $file (@$stuffRef) {
  183.          my $relFile=substr($file,$inDirLen+1);
  184.          my $base=basename($relFile);
  185.          if($opt_move) {
  186.             my $targetsubdir = $dirPrefixAbs."/$prefixBase$i";
  187.             $targetsubdir .= "/".dirname($relFile) if($opt_dir);
  188.             print "$file -> $targetsubdir/$base\n" if($opt_ver);
  189.             if(!$opt_sim) {
  190.                mkpath $targetsubdir || die "Problems creating $targetsubdir\n";
  191.                # last check
  192.                die "Could not create $targetsubdir?\n" if(!(-d $targetsubdir && -w $targetsubdir));
  193.                if($opt_sln) {
  194.                   symlink($file, "$targetsubdir/$base");
  195.                }
  196.                elsif($opt_ln) {
  197.                   if(-d $file && !-l $file) {
  198.                      mkdir "$targetsubdir/$base";
  199.                   }
  200.                   else {
  201.                      link($file, "$targetsubdir/$base");
  202.                   }
  203.                }
  204.                else {
  205.                   rename($file, "$targetsubdir/$base");
  206.                }
  207.             }
  208.          }
  209.          else {
  210.             # escape = in mkisofs catalogs, they are used as separator
  211.             my $isoname = ($opt_dir?$relFile : $base);
  212.             $isoname=~s/=/\\=/g;
  213.             my $sourcefile=$file;
  214.             $sourcefile=~s/=/\\=/g;
  215.             print "$i: /$isoname=$sourcefile\n" if $opt_ver;
  216.             print $o "/$isoname=$sourcefile\n" if(!$opt_sim);
  217.          }
  218.       }
  219.    }
  220.    close($o) if($o);
  221. }
  222.  
  223. exit $ret;
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263. # recursive function
  264. # parameter: directory
  265. # mode 1: descend as far as possible and index all non-directories
  266. # mode 2++:
  267. # put all files of a dir into coaleseced-object, then descend into each dir
  268. sub explore {
  269.    (my $dir) = @_;
  270.    my @stuff;
  271.    my @dirs;
  272.    my @files;
  273.  
  274.    opendir(DIR, $dir) || die "Could not open $dir\n";
  275.    @stuff=readdir(DIR);
  276.    
  277.    if($opt_simple) {
  278.       @stuff=sort { lc($a) cmp lc($b) } @stuff;
  279.    }
  280.       
  281.    foreach my $f (@stuff) {
  282.       next if ($f eq "." || $f eq "..");
  283.       #print "\$f=$opt_filter;\n";
  284.       
  285.       $f="$dir/$f" if($dir ne ".");
  286.  
  287.       if ($opt_filter) {
  288.          next unless (eval("\$f=~$opt_filter;"));
  289.       }
  290.  
  291.       if(-l $f && ! $opt_follow) {
  292.          push(@files, $f);
  293.       }
  294.       elsif(-d $f) {
  295.          push(@dirs, $f);
  296.       }
  297.       else {
  298.          push(@files, $f);
  299.       }
  300.    }
  301.    closedir(DIR);
  302.  
  303.    if( (@dirs + @files) == 0 ) {
  304.       # this one is empty, register for cosmetics reason
  305.       &insitem(getsize($dir), $dir);
  306.       return;
  307.    }
  308.    
  309.    # recurse on directories
  310.    &explore($_) for(@dirs);
  311.  
  312.    # and now process files
  313.    if($emode==1) {
  314.       &insitem(getsize($_), $_) for(@files);
  315.    }
  316.    else {
  317.       # handle coalesced objects - first some sanity checks and splitting if
  318.       # required
  319.  
  320.       my $filesum=0;
  321.       for(@files) {
  322.          my $tmp=getsize($_);
  323.          if($tmp>$max) {
  324.             # already too large, stop right here
  325.             die "Too large file ($_) for the given max size $max, aborting...\n";
  326.          }
  327.          $filesum += $tmp;
  328.       };
  329.  
  330.       # handle coal. objects becoming too large
  331.       if($filesum>$max) {
  332.          # too large coal. object...
  333.          if($emode==3) {
  334.             # don't coalesc in this mode, do like mode 1 above, leave them alone
  335.             &insitem(getsize($_), $_) for(@files);
  336.             return;
  337.          }
  338.          # a bit complicated, split file set while creating coal.objects
  339.          if($emode==4) {
  340.             my $partsum=0;
  341.             my @sorted=sort(@files);
  342.             my @tmpvol;
  343.             for(my $i=0;$i<=$#sorted;$i++) {
  344. #            print "D: i: $i, partsum: $partsum, file: $sorted[$i]\n";
  345.                my $tmp=getsize($sorted[$i]);
  346.                $partsum+=$tmp;
  347.                if($partsum>$max) {
  348.                   # undo the last step then build the coal.object
  349.                   $partsum-=$tmp;
  350.                   $i--;
  351.  
  352.                   &insitem($partsum, \@tmpvol);
  353.                   # reset temporaries
  354.                   undef @tmpvol;
  355.                   undef $partsum;
  356.                }
  357.                else {
  358.                   push(@tmpvol, $sorted[$i]);
  359.                }
  360.             }
  361.             return;
  362.          }
  363.       }
  364.  
  365.       # ok, building a coalesced object for simple cases
  366.       if($filesum) {
  367.          &insitem($filesum, \@files);
  368.       }
  369.    }
  370. }
  371.  
  372. my $simplePos=0;
  373. my @simpleBinSizes;
  374.  
  375. # args: size, object (filename or list reference)
  376. sub insitem {
  377.    my ($size, $object) = @_;
  378.    # normaly, put the items into the pool for calculation. In simple mode, calculate here
  379.    
  380.    push(@sizes, $size);
  381.    push(@{$names{$size}},$object);
  382.  
  383.    if($opt_simple) {
  384.       # now the simplest method to fill the bins, just take a new one when the
  385.       # object-to-be-added no longer fits
  386.       if($simpleBinSizes[$simplePos]+$size > $max) {
  387.          $globwaste += ( $max-$simpleBinSizes[$simplePos] );
  388.          $simplePos++;
  389.       };
  390.       $simpleBinSizes[$simplePos]+=$size;
  391.       push( @{$result[$simplePos]}, $object);
  392.    }
  393.    
  394. }
  395.  
  396. sub getsize {
  397.    (my $file) = @_;
  398.    my $size = ((stat($file))[7]);
  399.    my $rest = ($size % $bsize);
  400.    $size = ($size + $bsize - $rest) if ($rest);
  401.    return 1+int(200 + $ofac*length(basename($file)) + $size);
  402. }
  403.    
  404. sub parseListe {
  405.    my $fh=${$_[0]};
  406.    while(<$fh>) {
  407.       if(/^(\w+)\s+(.+)/) {
  408.          &insitem(fixnr($1), $2);
  409.       }
  410.    }
  411. }
  412.  
  413. sub fixnr {
  414.    # args: 
  415.    # Number
  416.    # optional: default multiplier
  417.    my $fac;
  418.    my $nr;
  419.    if($_[0]=~/(\d+)(\D)/) {
  420.       $nr=$1;
  421.       $fac=$2;
  422.    }
  423.    elsif(defined($_[1])) {
  424.       $nr=$_[0];
  425.       $fac=$_[1];
  426.    }
  427.    else {
  428.       return $_[0];
  429.    }
  430.    return $nr*1000000000 if($fac eq "g");
  431.    return $nr*1073741824 if($fac eq "G");
  432.    return $nr*1000000 if($fac eq "m");
  433.    return $nr*1048576 if($fac eq "M");
  434.    return $nr*1000 if($fac eq "k");
  435.    return $nr*1024 if($fac eq "K");
  436.    return $nr if($fac eq "b");
  437.    die "$fac is not a valid multiplier!";
  438. }
  439.  
  440.  
  441. sub show_help {
  442.    print <<EOM
  443. dirsplit [options] [advanced options] < directory >
  444.  
  445.  -H|--longhelp Show the long help message with more advanced options
  446.  -n|--no-act   Only print the commands, no action (implies -v)
  447.  -s|--size     NUMBER - Size of the medium (default: $max)
  448.  -e|--expmode  NUMBER - directory exploration mode (recommended, see long help)
  449.  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
  450.  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
  451.  -h|--help     Show this option summary
  452.  -v|--verbose  More verbosity
  453.                    
  454. The complete help can be displayed with the --longhelp (-H) option.
  455. The default mode is creating file catalogs useable with:
  456.     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
  457.  
  458. Example:
  459. dirsplit -m -s 700M -e2 random_data_to_backup/
  460. EOM
  461.    ;
  462.    exit shift;
  463. }
  464.  
  465. sub show_longhelp {
  466.    my $msglong="
  467. dirsplit [options] [advanced options] < directory >
  468.  -n|--no-act   Only print the commands, no action (implies -v)
  469.  -s|--size     NUMBER - Size of the medium (default: $max)
  470.  -m|--move     Move files to target dirs (default: create mkisofs catalogs)
  471.  -l|--symlink  similar to -m but just creates symlinks in the target dirs
  472.  -L|--hardlink like -l but creates hardlinks
  473.  -p|--prefix   STRING - first part of catalog/directory name (default: vol_)
  474.  -f|--filter   EXPR - Filter expression, see examples below and perlre manpage
  475.  --flat        Flat dir mode, don't recreate subdirectory structure (not recommended)
  476.  -e|--expmode  NUMBER, special exploration modes, used with directory argument
  477.  
  478.   1: (default) native exploration of the specified directory, but file sizes
  479.                are rounded up to 2048 blocks plus estimated overhead for
  480.                filenames (see -o option)
  481.   2: like 1, but all files in directory are put together (as \"atom\") onto the
  482.                same medium. This does not apply to subdirectories, however.
  483.   3: like 2, but don't coalesc files when the size of the \"atom\" becomes too
  484.                large for the medium size (currently $max)
  485.   4: like 2, but the max. size of the atoms is limited to $max (storing the
  486.                rest on another medium)
  487.  
  488.  -F|--follow   Follow symlinks. Use with care!
  489.  -b|--blksize  NUMBER, block size of the target filesystem (currently $bsize).
  490.  -o|--overhead NUMBER, overhead caused by directory entries (as factor for the
  491.                filename length, default: 50, empiricaly found for Joliet+RR
  492.                with not-so-deep directory structure). Works in exploration
  493.                mode.
  494.  -a|--accuracy NUMBER (1=faster, large number=better efficiency, default: 500)
  495.  -S|--simple   Simple/stupid/alphabetic mode
  496.  -T|--input    FILENAME (or - for STDIN):  List with sizes and paths, try:
  497.                find dir -type f -printf \"%s %p\n\"
  498.                to get an example. Avoid duplicates! Unit suffixes are allowed.
  499.  -h|--help     Show this option summary
  500.  -v|--verbose  More verbosity
  501.                    
  502. File sizes are expected to be in bytes, append modifier letters to multiply
  503. with a factor, eg 200M (b,k,K,m,M,g,G for Bytes, Kb, KiB, Mb, MiB, Gb, GiB).
  504. The default output mode is creating file catalogs useable with
  505.     mkisofs -D -r --joliet-long -graft-points -path-list CATALOG
  506.  
  507. Examples:
  508. dirsplit -m -s 120M -e4 largedirwithdata/ -p /zipmedia/backup_   #move stuff into splitted backup dirs
  509. dirsplit -s 700M -e2 music/ # make mkisofs catalogs to burn all music to 700M CDRs, keep single files in each dir together
  510. dirsplit -s 700M -e2 -f '/other\\/Soundtracks/' music/ # like above, only take files from other/Soundtracks
  511. dirsplit -s 700M -e2 -f '!/Thumbs.db|Desktop.ini|\\.m3u\$/i' # like above, ignore some junk files and playlists, both letter cases
  512.  
  513. Bugs: overhead trough blocksize alignment and directory entry storage varies,
  514. heavily depends on the target filesystem and configuration (see -b and -o).
  515.  
  516. You should compare the required size of the created catalogs, eg.:
  517. for x in *list ; do mkisofs -quiet -D -r --joliet-long -graft-points \\
  518.  -path-list \$x -print-size; done
  519. (output in blocks of 2048 bytes) with the expected size (-s) and media data
  520. (cdrecord -v -toc ...). 
  521. ";
  522.    print $msglong;
  523.    exit 0;
  524. }
  525.  
  526. # Parms: bin size (int), input array (arr reference), output array (arr reference)
  527. # Returns: wasted space (int)
  528. sub bp_bestfit {
  529.    my $max=$_[0];
  530.    my @in = @{$_[1]};
  531.    my $target = $_[2];
  532.    my @out;
  533.    my @bel;
  534.  
  535.    my @tmp;
  536.    push(@tmp,$in[0]);
  537.    push(@out, \@tmp);
  538.    $bel[0] = $in[0];
  539.    shift @in;
  540.  
  541.    for(@in) {
  542.       my $bestplace=$#out+1;
  543.       my $bestwert=$max;
  544.       for($i=0;$i<=$#out;$i++) {
  545.          my $rest;
  546.          $rest=$max-$bel[$i]-$_;
  547.          if($rest>0 && $rest < $bestwert) {
  548.             $bestplace=$i;
  549.             $bestwert=$rest;
  550.          };
  551.       }
  552.       if($bestplace>$#out) {
  553.          my @bin;
  554.          $bel[$bestplace]=$_;
  555.          push(@bin, $_);
  556.          push(@out,\@bin);
  557.       }
  558.       else{
  559.          $bel[$bestplace]+=$_;
  560.          push(  @{$out[$bestplace]}    , $_);
  561.       }
  562.    }
  563.    my $ret=0;
  564.    # count all rests but the last one
  565.    for($i=0;$i<$#out;$i++) {
  566.       $ret+=($max-$bel[$i]);
  567.    }
  568.    @{$target} = @out;
  569.    return $ret;
  570. }
  571.  
  572. # Parms: bin size (int), input array (arr reference), output array (arr reference)
  573. # Returns: wasted space (int)
  574. sub bp_firstfit {
  575.    my $max=$_[0];
  576.    my @in = @{$_[1]};
  577.    my $target = $_[2];
  578.    my @out;
  579.    my @bel;
  580.  
  581.    piece: foreach my $obj (@in) {
  582.       # first fit, use the first bin with enough free space
  583.       #       print "F: bin$i: $obj, @{$names{$obj}}\n";
  584.       for($i=0;$i<=$#out;$i++) {
  585.          my $newsize=($bel[$i]+$obj);
  586. #         print "bel[i]: $bel[$i], new?: $newsize to max: $max\n";
  587.          if( $newsize <= $max ) {
  588. #            print "F: bin$i: $bel[$i]+$obj=$newsize\n";
  589.             #fits here
  590.             $bel[$i]=$newsize;
  591.             push(  @{$out[$i]} , $obj);
  592.             next piece; # break
  593.          }
  594.       }
  595.       # neues Bin
  596.       my @bin;
  597.       $bel[$i]=$obj;
  598. #      print "N: bin$i: $bel[$i]=$obj\n";
  599.       push(@bin, $obj);
  600.       push(@out,\@bin);
  601.    }
  602.    my $ret=0;
  603.    # sum up all rests except of the one from the last bin
  604.    for($i=0;$i<$#out;$i++) {
  605. #           print "hm, bel $i ist :".$bel[$i]." und res:".($max-$bel[$i])."\n";
  606.       $ret+=($max-$bel[$i]);
  607.    }
  608.    @{$target} = @out;
  609. #      print "wtf, ".join(",", @{$out[0]})."\n";
  610.    return $ret;
  611. }
  612.